REM AutoTONE Phone Tone Generator Version 3.16
REM by The (403) Phoney
REM Original Concept: /TUC403/
REM Edmonton, Alberta, Canada

        CLEAR,20000,5000
        DIM a%(256):DIM t$(58)
        GOSUB intro1
        FOR x=1 TO 800:NEXT
        GOSUB intro2
        LOCATE 9,17:PRINT "AutoTONE - by The (403) Phoney"
        FOR x=1 TO 500:NEXT
        GOSUB intro2
        GOSUB intro3
        FOR x=1 TO 3000:NEXT
        GOSUB setup
        GOSUB info
        GOSUB contents
        GOSUB controls
loop:
        WHILE ok
            event=0
            WINDOW OUTPUT 1
            WHILE event=0: event=<0x43,0x07>(0):WEND
            IF event=1 THEN GOSUB parm
            IF event=5 THEN GOSUB refresh
        WEND
quit:
        CLEAR
        WINDOW CLOSE 3
        WINDOW CLOSE 2
        WINDOW CLOSE 1
        CLS
        SYSTEM
      END
        
intro1:
        SOUND WAIT:POKEW 1,SIN:POKEW 2,SIN:POKEW 3,SIN:POKEW 0,SIN
        n=2:d=25:d1=350:d2=440:GOSUB tone
    RETURN
    
intro2:        
        d=4:FOR x=1 TO 2
        d1=697:d2=1477:GOSUB tone
        d1=770:d2=1477:GOSUB tone
        d1=697:d2=1477:GOSUB tone
        d1=697:d2=1209:GOSUB tone
        NEXT
    RETURN
    
intro3:
        d=30:m=5
        d1=440:d2=480:GOSUB tone2
    RETURN

setup:
        CLS
        wf=1:GOSUB waveform
        WINDOW 1,"Keypad",(0,190)-(511,341),3
        CALL <0x1a,0x07>(3):CALL <0x1a,0x01>(12):CALL <0x1a,0x00>(1)
        WINDOW 2,"Output ",(0,45)-(511,189),3
        CALL <0x12,0x07>(3):CALL <0x12,0x01>(12)
        WINDOW 3 ,"About AutoTONE",(0,20)-(511,44),3
        CALL <0x11,0x07>(3):CALL <0x11,0x01>(9)
        wrap=61:ll=0:box=1:ok=1:tp=0:mn=11:tb=58:v=255:noise=3300
    RETURN
        
info:
        WINDOW OUTPUT 3
        CLS
        CALL <0x53,0x07>(0):PRINT SPC(15);"AutoTONE Phone Tone Generator Version 3   by The (403) Phoney "
    RETURN

controls:
        t=1
        WINDOW  1
        FOR y=1 TO 2
            FOR x=1 TO 3
                <0x40,0x07> (y-1)*3+x,1,t$(t),(60*x-50,40*y-10)-(60*x,40 *y+20),1
                t=t+1
            NEXT
        NEXT
        <0x40,0x07> 7,1,t$(t),(10,110)-(60,140),1
        t=t+1
        <0x40,0x07> 8,1,t$(t),(70,110)-(180,140),1
        t=t+1
        LINE (195,0)-(195,151)
        FOR y=1 TO 3
            <0x40,0x07> 8+y,1,t$(t),(210,40*y-10)-(280,40*y+20),1
            t=t+1
        NEXT
        LINE (300,0)-(300,151)
        np=3:p=0:GOSUB arrow
        GOSUB dobox
        LOCATE 1,4:PRINT "TONE BOX MENU"
        LOCATE 1,24:PRINT"WAVEFORM"
    RETURN

dobox:
        ON box GOSUB DTMF,MF,SILVER,BLUE,RED,GREEN
        max=max+mn
        CALL <0x09,0x07>(1)
        LOCATE 1,40:PRINT"                         ":LOCATE 1,pp:PRINT bn$
        np=2:p=tp:GOSUB arrow
    RETURN

DTMF:
        t=12
        FOR y= 1 TO 4
            FOR x= 1 TO 3
                <0x40,0x07> (y-1)*3+x+mn,1,t$(t),(30*x+310,30*y)-(30*x+330,30*y+20),1
                t=t+1
            NEXT
        NEXT
        max=12:pp=41:bn$="DTMF"
    RETURN

MF:
        t=24
        FOR y=1 TO 3
            FOR x=1 TO 3
                <0x40,0x07> (y-1)*3+x+mn,1,t$(t),(30*x+310,30*y)-(30*x+330,30*y+20),1
                t=t+1
            NEXT
        NEXT
        <0x40,0x07> 10+mn,1,t$(t),(370,120)-(390,140),1
        t=t+1
        max=10:pp=42:bn$="MF"
    RETURN

SILVER:
        t=34
        FOR y=1 TO 4
            <0x40,0x07> y+mn,1,t$(t),(375,30*y)-(395,30*y+20),1
            t=t+1
        NEXT
        max=4:pp=41:bn$="SILVER"
    RETURN

 BLUE:
        t=38
        FOR y=1 TO 4
            FOR x=1 TO 2
                <0x40,0x07> (y-1)*2+x+mn,1,t$(t),(60*x+260,30*y)-(60*x+310,30*y+20),1
                t=t+1
            NEXT
        NEXT
        FOR y=1 TO 2
            <0x40,0x07> y+8+mn,1,t$(t),(440,40*y-10)-(460,40*y+20),1
            t=t+1
        NEXT
        max=10:pp=41:bn$="BLUE       TYPE"
    RETURN

RED:
        t=48
        FOR y=1 TO 4
            <0x40,0x07> y+mn,1,t$(t),(360,30*y)-(430,30*y+20),1
            t=t+1
        NEXT
        FOR y=1 TO 2
            <0x40,0x07> y+4+mn,1,t$(t),(440,40*y-10)-(460,40*y+20),1
            t=t+1
        NEXT
        max=6:pp=43:bn$="RED      TYPE"
    RETURN

GREEN:
        t=54
        FOR y=1 TO 3
            <0x40,0x07> y+mn,1,t$(t),(375,30*y)-(415,30*y+20),1
            t=t+1
        NEXT
        FOR y=1 TO 2
            <0x40,0x07> y+3+mn,1,t$(t),(440,40*y-10)-(460,40*y+20),1
            t=t+1
        NEXT      

        max=5:pp=42:bn$="GREEN     TYPE"
    RETURN

cleanup:
        FOR bcl=mn+1 TO max:<0x40,0x07> CLOSE bcl:NEXT:RETURN

refresh:
        IF <0x43,0x07>(5)<2 THEN GOSUB info: GOSUB controls
    RETURN

sweep:
        WINDOW OUTPUT 2
        CLS
        CALL <0x23,0x07>(0):PRINT "Output Window Cleared"
        ll=0
    RETURN
    
arrow:
        CALL <0x09,0x07>(1)
        yp=3:yo=3
        IF np=3 THEN xp=32  :ELSE xp=52
        FOR x=0 TO np-1:LOCATE x*yo+yp,xp:PRINT "   ":NEXT
        IF box=4 OR box=5 OR box=6 OR np=3 THEN LOCATE p*yo+yp,xp:PRINT "<<"
    RETURN

contents:
        FOR x=1 TO tb:READ t$(x):NEXT:
        DATA DTMF,MF,SILVER,BLUE,RED,GREEN,CLR,QUIT !,sine,sawtooth,square,1,2,3,4,5,6,7,8,9,*,0,#,1,2,3,4,5,6,7,8,9,0,A,B,C,D,2600,2750,3700,KP,ST,ST2P,ST3P,STP,0,1,nickel,dime,quarter33,quarter66,0,1,c/c,c/r,r/b,0,1
    RETURN

parm:
        d=3:n=2:l=1:m=1:f=0:dwd=1.1:dw=2600:dbd=1.7:tps=0
        p=<0x43,0x07>(1)
        IF p<7 THEN box=p:GOSUB cleanup:GOSUB dobox
        IF p=7 THEN GOSUB sweep
        IF p=8 THEN ok=0
        IF p>8 AND p<12 THEN wf=p-8:GOSUB waveform
        IF p>11 THEN b=p-11:ON box GOSUB dwbt,mwbt,sbt,bbt,rbt,gbt,oct:GOSUB out
    RETURN

dwbt:
        IF b=1 THEN a$="1":d1=697:d2=1209
        IF b=2 THEN a$="2":d1=697:d2=1336
        IF b=3 THEN a$="3":d1=697:d2=1477
        IF b=4 THEN a$="4":d1=770:d2=1209
        IF b=5 THEN a$="5":d1=770:d2=1336
        IF b=6 THEN a$="6":d1=770:d2=1477
        IF b=7 THEN a$="7":d1=852:d2=1209
        IF b=8 THEN a$="8":d1=852:d2=1336
        IF b=9 THEN a$="9":d1=852:d2=1477
        IF b=10 THEN a$="*":d1=941:d2=1209
        IF b=11 THEN a$="0":d1=941:d2=1336
        IF b=12 THEN a$="#":d1=941:d2=1477
    RETURN

mwbt:
        f=4
        IF b=1 THEN a$="1":d1=700:d2=900
        IF b=2 THEN a$="2":d1=700:d2=1100
        IF b=3 THEN a$="3":d1=900:d2=1100
        IF b=4 THEN a$="4":d1=700:d2=1300
        IF b=5 THEN a$="5":d1=900:d2=1300
        IF b=6 THEN a$="6":d1=1100:d2=1300
        IF b=7 THEN a$="7":d1=700: d2=1500
        IF b=8 THEN a$="8":d1=900:d2=1500
        IF b=9 THEN a$="9":d1=1100:d2=1500
        IF b=10 THEN a$="0":d1=1300:d2=1500
    RETURN
        
sbt:
        IF b=1THEN a$="-Flash (A)-": d1=697: d2=1633:l=11
        IF b=2 THEN a$="-Immediate (B)-": d1=770: d2=1633:l=15
        IF b=3 THEN a$="-Priority (C)-":d1=852:d2=1633:l=14
        IF b=4 THEN a$="-Routine (D)-":d1=941:d2=1633:l=13
    RETURN

bbt:
        np=2:p=tp
        IF tp THEN d2=noise :ELSE d2=0
        IF b=1 THEN a$="-2600 Hz-":d1=2600:d=10:l=9:f=4
        IF b=2 THEN a$="-2750 Hz-":d1=2750:d=10:l=9:f=4
        IF b=3 THEN a$="-3700 Hz-":d1=3700:d=10:l=9:f=4
        IF b=4 THEN a$="-KP (KP1)-":d1=1100:d2=1700:d=5:l=10
        IF b=5 THEN a$="-ST (ST)-":d1=1500:d2=1700:l=9
        IF b=6 THEN a$="-ST3P (Code 11)-":d1=700:d2=1700:l=16
        IF b=7 THEN a$="-STP (Code 12)-":d1=900:d2=1700:l=15
        IF b=8 THEN a$="-ST2P (KP2)-":d1=1300:d2=1700:l=12
        IF tp<1 THEN f=0
        IF b=9 THEN tp=0:p=tp:GOSUB arrow:tps=1
        IF b=10 THEN tp=1:p=tp:GOSUB arrow:tps=1
    RETURN
        
rbt:
        d1=1700:d2=2200:np=2:p=tp
        IF b=1 THEN a$="-nickel-":d=1.2:m=1:l=8
        IF b=2 THEN a$="-dime-":d=1.2:m=2:l=8
        IF b=3 THEN a$="-quarter(33)-":d=0.6:m=5:l=13
        IF b=4 THEN a$="-quarter(66)-":d=1.2:m=5:l=13
        IF b=5 THEN tp=0:p=tp:GOSUB arrow:tps=1
        IF b=6 THEN tp=1:p=tp:GOSUB arrow:tps=1
        IF tp THEN d2=0:f=4
        IF tp AND b>2 THEN d1=800:m=1
    RETURN
        
gbt:
        d=15:dwd=1.638:dbd=1.092:dw1=2600:dw2=0:np=2:p=tp
        IF tp THEN dw1=900:dw2=1500:f=4
        IF b=1 THEN a$="-coin collect-":d1=700:d2=1100:l=14
        IF b=2 THEN a$="-coin return-":d1=1100:d2=1700:l=13
        IF b=3 THEN a$="-ringback-":d1=700:d2=1700:l=10
        IF b=4 THEN tp=0:p=tp:GOSUB arrow:tps=1
        IF b=5 THEN tp=1:p=tp:GOSUB arrow:tps=1
    RETURN
        
waveform:
        ON wf GOSUB one,two,three
        np=3:p=wf-1:GOSUB arrow
    RETURN
        
one:
        SOUND WAIT:POKEW 1,SIN:POKEW 2,SIN:POKEW 3,SIN:POKEW 0,SIN
    RETURN

two:
        FOR wfb=0 TO 255:a%(wfb)=-128+wfb:NEXT
        SOUND WAIT:POKEW 1,a%:POKEW 2,a%:POKEW 3,a%:POKEW 0,a%
    RETURN

three:
        FOR wfb=0 TO 255:IF wfb<127 THEN a%(wfb)=-128 :ELSE a%(wfb)=127
        NEXT:SOUND WAIT:POKEW 1,a%:POKEW 2,a%:POKEW 3,a%:POKEW 0,a%
    RETURN

out:
        IF  tps THEN RETURN
        SOUND WAIT
        WINDOW OUTPUT 2
        ll=ll+l
        CALL <0x0b,0x07>(f)
        IF ll>wrap THEN ll=0:PRINT CHR$(13)
        PRINT a$;
        ON box GOSUB tone,tone,tone,tone,tone2,tone3
    RETURN

tone:
        SOUND d1,d,v,1
        IF n>1 THEN SOUND d2,d,v,2
        IF n>2 THEN SOUND d3,d,v,3
        IF n>3 THEN SOUND d4,d,v,0
        SOUND RESUME
    RETURN

tone2:
        FOR rep=1 TO m
          SOUND d1,d,v,1:SOUND d2,d,v,2
          SOUND 0,d,0,1:SOUND 0,d,0,2
        NEXT
        SOUND RESUME
    RETURN

tone3:
        SOUND dw1,dwd,v,1:SOUND dw2,dwd,(v*tp),2
        SOUND 0,dbd,0,1:SOUND 0,dbd,0,2
        SOUND d1,d,v,1:SOUND d2,d,v,2
        SOUND RESUME
        RETURN